Nelsen Intro to copulas - Chp 2

2.1 Preliminaries

Ex 2.1

#H volume generator function 
mk_Hvol<-function(fun=NULL){
  
  function(x,y){
    fun(x[2],y[2])-fun(x[2],y[1])-fun(x[1],y[2])+fun(x[1],y[1])
  }
  
}

# make vectorized function
H1<-function(x,y) mapply(function(x,y) max(x,y),x,y)

# create H-volume function
H1_vol<-mk_Hvol(fun=H1)

#H1_vol(c(0,1),c(0,1))

x<-y<-seq(0,1,length=50)
z1<-outer(x,y,FUN="H1") #same as outer(x,y,FUN="pmax")

# color scheme
num_col<-100
#color <- heat.colors(num_col)
color <- rev(rainbow(num_col, start = 0/6, end = 4/6))


if(0){
wireframe(z1, drape=TRUE)
wireframe(z1, drape=TRUE,screen=list(z=30, x=-60))
wireframe(z1, drape=TRUE,screen=list(z=20, x=-60))
wireframe(z1, drape=TRUE,screen=list(z=20, x=-80))
wireframe(z1, drape=TRUE,screen=list(z=30, x=-80))

persp(x,y,z1)
}

The H-volume for \(H(x,y)=\max(x,y)\) is -1, so this function is not 2-increasing.

contour(x,y,z1)

Contour plot

image(x,y,z1,col=color)

Color image

zcol <- cut(z1, num_col)
persp3d(x,y,z1, col=color[zcol])
movie3d_mod(spin3d(axis = c(0, 0, 1), rpm = 6), duration = 10, 
        movie="ex1",dir=file.path(getwd(),"fig") )

## Writing 'ex1000.png'
Writing 'ex1001.png'
Writing 'ex1002.png'
Writing 'ex1003.png'
Writing 'ex1004.png'
Writing 'ex1005.png'
Writing 'ex1006.png'
Writing 'ex1007.png'
Writing 'ex1008.png'
Writing 'ex1009.png'
Writing 'ex1010.png'
Writing 'ex1011.png'
Writing 'ex1012.png'
Writing 'ex1013.png'
Writing 'ex1014.png'
Writing 'ex1015.png'
Writing 'ex1016.png'
Writing 'ex1017.png'
Writing 'ex1018.png'
Writing 'ex1019.png'
Writing 'ex1020.png'
Writing 'ex1021.png'
Writing 'ex1022.png'
Writing 'ex1023.png'
Writing 'ex1024.png'
Writing 'ex1025.png'
Writing 'ex1026.png'
Writing 'ex1027.png'
Writing 'ex1028.png'
Writing 'ex1029.png'
Writing 'ex1030.png'
Writing 'ex1031.png'
Writing 'ex1032.png'
Writing 'ex1033.png'
Writing 'ex1034.png'
Writing 'ex1035.png'
Writing 'ex1036.png'
Writing 'ex1037.png'
Writing 'ex1038.png'
Writing 'ex1039.png'
Writing 'ex1040.png'
Writing 'ex1041.png'
Writing 'ex1042.png'
Writing 'ex1043.png'
Writing 'ex1044.png'
Writing 'ex1045.png'
Writing 'ex1046.png'
Writing 'ex1047.png'
Writing 'ex1048.png'
Writing 'ex1049.png'
Writing 'ex1050.png'
Writing 'ex1051.png'
Writing 'ex1052.png'
Writing 'ex1053.png'
Writing 'ex1054.png'
Writing 'ex1055.png'
Writing 'ex1056.png'
Writing 'ex1057.png'
Writing 'ex1058.png'
Writing 'ex1059.png'
Writing 'ex1060.png'
Writing 'ex1061.png'
Writing 'ex1062.png'
Writing 'ex1063.png'
Writing 'ex1064.png'
Writing 'ex1065.png'
Writing 'ex1066.png'
Writing 'ex1067.png'
Writing 'ex1068.png'
Writing 'ex1069.png'
Writing 'ex1070.png'
Writing 'ex1071.png'
Writing 'ex1072.png'
Writing 'ex1073.png'
Writing 'ex1074.png'
Writing 'ex1075.png'
Writing 'ex1076.png'
Writing 'ex1077.png'
Writing 'ex1078.png'
Writing 'ex1079.png'
Writing 'ex1080.png'
Writing 'ex1081.png'
Writing 'ex1082.png'
Writing 'ex1083.png'
Writing 'ex1084.png'
Writing 'ex1085.png'
Writing 'ex1086.png'
Writing 'ex1087.png'
Writing 'ex1088.png'
Writing 'ex1089.png'
Writing 'ex1090.png'
Writing 'ex1091.png'
Writing 'ex1092.png'
Writing 'ex1093.png'
Writing 'ex1094.png'
Writing 'ex1095.png'
Writing 'ex1096.png'
Writing 'ex1097.png'
Writing 'ex1098.png'
Writing 'ex1099.png'
Writing 'ex1100.png'

## Loading required namespace: magick

#play3d(spin3d(axis = c(0, 0, 1), rpm = 6), duration = 10)

Ex 2.1 gif of H(x,y)=max(x,y)

Ex 2.2

# make vectorized function
H2<-function(x,y) mapply(function(x,y) (2*x-1)*(2*y-1), x,y)

# create H-volume function
H2_vol<-mk_Hvol(fun=H2)

#H2_vol(c(0,1),c(0,1))

z2<-outer(x,y,FUN="H2")

if(0){
wireframe(z2, drape=TRUE)
wireframe(z2, drape=TRUE,screen=list(z=30, x=-60))
wireframe(z2, drape=TRUE,screen=list(z=20, x=-60))
wireframe(z2, drape=TRUE,screen=list(z=20, x=-80))
wireframe(z2, drape=TRUE,screen=list(z=30, x=-80))
}

The H-volume for \(H(x,y)=(2x-1)(2y-1)\) is 4, so this function is 2-increasing.

contour(x,y,z2)

Contour plot

image(x,y,z2,col=color)

Color Image

z2col  <- cut(z2, num_col)
plotids<-persp3d(x,y,z2, col=color[z2col])
rglwidget(elementId = "plot3drgl")

Interactive Plot

Ex 2.3

# make vectorized function
H3<-function(x,y) mapply(function(x,y) ((x+1)*(exp(y)-1))/(x+2*exp(y)-1), x,y)

# create H-volume function
H3_vol<-mk_Hvol(fun=H3)

#check 2-increasing
#H3_vol(c(-1,1),c(1e-15,500))

x3<-seq(-1,1,length=50)
y3<-seq(0,15,length=50)
z3<-outer(x3,y3,FUN="H3")

#H3(x3[4],y3[2])==z3[4,2]

contour(x3,y3,z3)

image(x3,y3,z3,col=color)

wireframe(z3, drape=TRUE, xlab="x", ylab="y")

wireframe(z3, drape=TRUE,screen=list(z=30, x=-60), xlab="x", ylab="y")

wireframe(z3, drape=TRUE,screen=list(z=20, x=-60), xlab="x", ylab="y")

z3col  <- cut(z3, num_col)
persp3d(x3,y3,z3, col=color[z3col])
fn<-spin3d(axis = c(0, 0, 1), rpm = 6)

rglwidget() %>% playwidget(par3dinterpControl(fn, 0, 10, steps=25),
       step = 0.1, loop = TRUE, rate = 0.75)